wine.csv, que contiene variantes del vino “Vinho Verde”. Los datos incluyen variables de pruebas fisicoquímicas y sensoriales realizadas a dicho vino.La tabla contiene 1599 filas y 12 columnas, las cuales se explican a continuación.
Para esto realice lo siguiente:
wine.csv en R.datos <- read.table("../datos/wine.csv", sep = ",", dec = ".", header = T, stringsAsFactors = T)R genere al azar una tabla de testing con una 20 % de los datos y con el resto de los datos genere una tabla de aprendizaje.filas <- dim(datos)[1]
muestra <- sample(1:filas, floor(filas*0.20))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]SVM con traineR para generar un modelo predictivo para la tabla de aprendizaje. Pruebe con todos los kernel (núcleos) linear, polynomial, radial basis y sigmoid hasta encontrar el que minimiza el error global.library(traineR)
modelo.linear <- train.svm(tipo~., data = taprendizaje, kernel = "linear")
prediccion.linear <- predict(modelo.linear, ttesting , type = "class")
MC.Linear <- confusion.matrix(ttesting, prediccion.linear)
linear <- general.indexes(mc = MC.Linear)
linear
Confusion Matrix:
prediction
real blanco tinto
blanco 968 6
tinto 5 320
Overall Accuracy: 0.9915
Overall Error: 0.0085
Category Accuracy:
blanco tinto
0.993840 0.984615
modelo.polynomial <- train.svm(tipo~., data = taprendizaje, kernel = "polynomial")
prediccion.polynomial <- predict(modelo.polynomial, ttesting , type = "class")
MC.polynomial <- confusion.matrix(ttesting, prediccion.polynomial)
polynomial <- general.indexes(mc = MC.polynomial)
polynomial
Confusion Matrix:
prediction
real blanco tinto
blanco 971 3
tinto 11 314
Overall Accuracy: 0.9892
Overall Error: 0.0108
Category Accuracy:
blanco tinto
0.996920 0.966154
modelo.radial <- train.svm(tipo~., data = taprendizaje, kernel = "radial")
prediccion.radial <- predict(modelo.radial, ttesting , type = "class")
MC.radial <- confusion.matrix(ttesting, prediccion.radial)
radial <- general.indexes(mc = MC.radial)
radial
Confusion Matrix:
prediction
real blanco tinto
blanco 972 2
tinto 5 320
Overall Accuracy: 0.9946
Overall Error: 0.0054
Category Accuracy:
blanco tinto
0.997947 0.984615
modelo.sigmoid <- train.svm(tipo~., data = taprendizaje, kernel = "sigmoid")
prediccion.sigmoid <- predict(modelo.sigmoid, ttesting , type = "class")
MC.sigmoid <- confusion.matrix(ttesting, prediccion.sigmoid)
sigmoid <- general.indexes(mc = MC.sigmoid)
sigmoid
Confusion Matrix:
prediction
real blanco tinto
blanco 960 14
tinto 20 305
Overall Accuracy: 0.9738
Overall Error: 0.0262
Category Accuracy:
blanco tinto
0.985626 0.938462
traineR genere un modelo predictivo para la tabla de aprendizaje. Pruebe modificar los parámetros del método hasta encontrar el que minimiza el error global.modelo.nnet <- train.nnet(tipo~. , data = taprendizaje, size = 4, maxit = 1000)# weights: 57
initial value 2829.967964
iter 10 value 1279.367965
iter 20 value 1117.955469
iter 30 value 912.086786
iter 40 value 719.590137
iter 50 value 644.233256
iter 60 value 602.213161
iter 70 value 338.275865
iter 80 value 242.861597
iter 90 value 218.549134
iter 100 value 195.120847
iter 110 value 180.507667
iter 120 value 178.636968
iter 130 value 177.633015
iter 140 value 176.739880
iter 150 value 176.333398
iter 160 value 175.581406
iter 170 value 175.139990
iter 180 value 174.437987
iter 190 value 174.002733
iter 200 value 173.846150
iter 210 value 173.329150
iter 220 value 169.486473
iter 230 value 163.371421
iter 240 value 163.100541
final value 163.099746
converged
prediccion.nnet <- predict(modelo.nnet, ttesting, type = "class")
MC.nnet <- confusion.matrix(ttesting,prediccion.nnet)
redesNeuronales <- general.indexes(mc=MC.nnet)
redesNeuronales
Confusion Matrix:
prediction
real blanco tinto
blanco 969 5
tinto 17 308
Overall Accuracy: 0.9831
Overall Error: 0.0169
Category Accuracy:
blanco tinto
0.994867 0.947692
library(dplyr)
precisiones <- rbind(as.data.frame(Confusion(linear$confusion.matrix)),as.data.frame(Confusion(polynomial$confusion.matrix)),as.data.frame(Confusion(radial$confusion.matrix)),as.data.frame(Confusion(sigmoid$confusion.matrix)),as.data.frame(Confusion(redesNeuronales$confusion.matrix)))
tablaC <- read.table("Tabla Comparativa wine2.csv",dec = ".",sep = "," , header = T)
tablaC <- rbind(precisiones,tablaC)
rownames(tablaC) <- c("SVM.linear","SVM.polynomial","SVM.radial","SVM.sigmoid","Redes Neuronales","Árboles de Decisión", "Bosques Aleatorios", "ADA Boosting", "XG Boosting","KNN.rectangular", "KNN.triangular", "KNN.epanechnikov", "KNN.biweight", "KNN.triweight", "KNN.cos",
"KNN.inv", "KNN.gaussian","KNN.optimal")
tablaC %>%
arrange(desc(Precision.Global))write.csv(tablaC,"Tabla Comparativa wine3.csv", row.names = FALSE)
tablaCEl modelo con la mejor Precisión Global fue KNN con kernel inv. Debido a que la Precisión Negativa y Precisión Positiva es bastante buena nos quedamos con este como el mejor modelo.
DeudaCredito.csv que contiene información de los clientes en una de las principales carteras de crédito del banco, e incluye variables que describen cada cliente tanto dentro del banco como fuera de este.Cargue la tabla de datos en R, asegúrese que las variables se están leyendo de forma correcta. Recodifique variables en caso de que sea necesario, tome para entrenamiento un 80 % de la tabla de datos. Realice lo siguiente:
library(fastDummies)
datos <- read.table("../datos/DeudaCredito.csv", dec = ".", sep = ",", header = T, stringsAsFactors = T )[,-1]
datos <- dummy_cols(datos, select_columns = c("Genero","Estudiante","Casado","Etnicidad"),remove_selected_columns = T)
str(datos)'data.frame': 400 obs. of 16 variables:
$ Ingreso : num 14.9 106 104.6 148.9 55.9 ...
$ Limite : int 3606 6645 7075 9504 4897 8047 3388 7114 3300 6819 ...
$ CalifCredit : int 283 483 514 681 357 569 259 512 266 491 ...
$ Tarjetas : int 2 3 4 3 2 4 2 2 5 3 ...
$ Edad : int 34 82 71 36 68 77 37 87 66 41 ...
$ Educacion : int 11 15 11 11 16 10 12 9 13 19 ...
$ Balance : int 333 903 580 964 331 1151 203 872 279 1350 ...
$ Genero_Femenino : int 0 1 0 1 0 0 1 0 1 1 ...
$ Genero_Masculino : int 1 0 1 0 1 1 0 1 0 0 ...
$ Estudiante_No : int 1 0 1 1 1 1 1 1 1 0 ...
$ Estudiante_Si : int 0 1 0 0 0 0 0 0 0 1 ...
$ Casado_0 : int 0 0 1 1 0 1 1 1 1 0 ...
$ Casado_1 : int 1 1 0 0 1 0 0 0 0 1 ...
$ Etnicidad_Afrodescendiente: int 0 0 0 0 0 0 1 0 0 1 ...
$ Etnicidad_Asiatico : int 0 1 1 1 0 0 0 1 0 0 ...
$ Etnicidad_Caucasico : int 1 0 0 0 1 1 0 0 1 0 ...
numero.predictoras <- dim(datos)[2] - 1
filas <- dim(datos)[1]
muestra <- sample(1:filas, floor(filas*0.20))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]SVM con todos los kernels disponibles e interprete las medidas de error del mejor de esos modelos.library(traineR)
modelo.linear <- train.svm(Balance~., data = taprendizaje, kernel = "linear")
prediccion.linear <- predict(modelo.linear, ttesting)
linear <- indices.precision(ttesting$Balance ,prediccion.linear$prediction,numero.predictoras)
linear$error.cuadratico
[1] 10662.37
$raiz.error.cuadratico
[1] 115.4468
$error.relativo
[1] 0.1236179
$correlacion
[1] 0.977489
modelo.polynomial <- train.svm(Balance~., data = taprendizaje, kernel = "polynomial")
prediccion.polynomial <- predict(modelo.polynomial, ttesting)
polynomial <- indices.precision(ttesting$Balance ,prediccion.polynomial$prediction,numero.predictoras)
polynomial$error.cuadratico
[1] 31556.26
$raiz.error.cuadratico
[1] 198.6085
$error.relativo
[1] 0.2611754
$correlacion
[1] 0.9284669
modelo.radial <- train.svm(Balance~., data = taprendizaje, kernel = "radial")
prediccion.radial <- predict(modelo.radial, ttesting)
radial <- indices.precision(ttesting$Balance ,prediccion.radial$prediction,numero.predictoras)
radial$error.cuadratico
[1] 17492.44
$raiz.error.cuadratico
[1] 147.87
$error.relativo
[1] 0.1593441
$correlacion
[1] 0.9623942
modelo.sigmoid <- train.svm(Balance~., data = taprendizaje, kernel = "sigmoid")
prediccion.sigmoid <- predict(modelo.sigmoid, ttesting)
sigmoid <- indices.precision(ttesting$Balance ,prediccion.sigmoid$prediction,numero.predictoras)
sigmoid$error.cuadratico
[1] 597056.4
$raiz.error.cuadratico
[1] 863.8985
$error.relativo
[1] 0.8695962
$correlacion
[1] 0.2631352
El mejor resultado lo obtuvo radial, con una correlación de 98.4% y un error en promedio de 12%. Em promedio se equivocó por 95.35.
library(ggplot2)
g <- plot.real.prediccion(ttesting$Balance, prediccion.linear$prediction , modelo = "SVM - Linear")
g + geom_smooth(method = lm, size = 0.4, color = "red", se = FALSE)g <- plot.real.prediccion(ttesting$Balance, prediccion.polynomial$prediction , modelo = "SVM - Polynomial")
g + geom_smooth(method = lm, size = 0.4, color = "red", se = FALSE)g <- plot.real.prediccion(ttesting$Balance, prediccion.radial$prediction , modelo = "SVM - Radial")
g + geom_smooth(method = lm, size = 0.4, color = "red", se = FALSE)g <- plot.real.prediccion(ttesting$Balance, prediccion.sigmoid$prediction , modelo = "SVM - Sigmoid")
g + geom_smooth(method = lm, size = 0.4, color = "red", se = FALSE)Se oberva que para casi todos los núcleos excepto Sigmoid los valores reales se alinean bastante bien al modelo, el núcleo linear es el que mejor ajusta, aunque los valores iguales a cero reales variarion un poco.
library(neuralnet)
library(traineR)
numero.predictoras <- dim(datos)[2] - 1
# Calcula el modelo usando solo los datos de training
# Se deben guardar las medias y las desviaciones
medias <- sapply(taprendizaje, mean)
desviaciones <- sapply(taprendizaje, sd)
# Se estandarizan los datos, esto se debe hacer de training y testing
taprendizaje.e <- as.data.frame(scale(taprendizaje, center = medias, scale = desviaciones))
ttesting.e <- as.data.frame(scale(ttesting, center = medias, scale = desviaciones))
# Generamos la fórmula
nombres <- colnames(taprendizaje.e)
formula <- as.formula(paste("Balance ~", paste(nombres[!nombres %in% c("Balance")], collapse = " + ")))
# Generamos modelo. No acepta la notación lpsa~.
# Los parámetros a modificar son hidden, threshold y stepmax
# hidden = c(6, 4, 3) => 3 capas ocultas una con 6 neuronas; otra con 4 neuronas y otra con 3 neuronas
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(4,3), linear.output = TRUE, threshold = 0.05, stepmax = 50000)
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)# Predicción
# Primero se obtiene la predicción estandarizada
prediccion.nnet2 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result
# Luego se calcula la predicción final "des-estandarizando" los resultados
prediccion.nnet2 <- prediccion.nnet2 * desviaciones["Balance"] + medias["Balance"]
# Medición de precisión
indices1 <- indices.precision(ttesting$Balance, prediccion.nnet2,numero.predictoras)
indices1$error.cuadratico
[1] 357.5161
$raiz.error.cuadratico
[1] 21.1399
$error.relativo
[1] 0.02517663
$correlacion
[1] 0.9991921
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(4,2), linear.output = TRUE, threshold = 0.05, stepmax = 50000)
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)# Predicción
prediccion.nnet3 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result
prediccion.nnet3 <- prediccion.nnet3 * desviaciones["Balance"] + medias["Balance"]
# Medición de precisión
indices3 <- indices.precision(ttesting$Balance, prediccion.nnet3,numero.predictoras)
indices3$error.cuadratico
[1] 184.9494
$raiz.error.cuadratico
[1] 15.20483
$error.relativo
[1] 0.01929812
$correlacion
[1] 0.999571
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(6,3), linear.output = TRUE, threshold = 0.05, stepmax = 50000)
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)# Predicción
prediccion.nnet4 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result
prediccion.nnet4 <- prediccion.nnet4 * desviaciones["Balance"] + medias["Balance"]
# Medición de precisión
indices4 <- indices.precision(ttesting$Balance, prediccion.nnet4,numero.predictoras)
indices4$error.cuadratico
[1] 214.3593
$raiz.error.cuadratico
[1] 16.36915
$error.relativo
[1] 0.02059658
$correlacion
[1] 0.9995021
Ambas mejoran al aumentar la cantidad de neuronas dentro de la red.
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(8,4,2), linear.output = TRUE, threshold = 0.05, stepmax = 50000)
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)# Predicción
prediccion.nnet5 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result
prediccion.nnet5 <- prediccion.nnet5 * desviaciones["Balance"] + medias["Balance"]
indices5 <- indices.precision(ttesting$Balance, prediccion.nnet5,numero.predictoras)
indices5$error.cuadratico
[1] 4401.601
$raiz.error.cuadratico
[1] 74.17547
$error.relativo
[1] 0.05611189
$correlacion
[1] 0.9905228
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(9,6,3), linear.output = TRUE, threshold = 0.05, stepmax = 50000)
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)# Predicción
prediccion.nnet6 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result
prediccion.nnet6 <- prediccion.nnet6 * desviaciones["Balance"] + medias["Balance"]
# Medición de precisión
indices6 <- indices.precision(ttesting$Balance, prediccion.nnet6,numero.predictoras)
indices6$error.cuadratico
[1] 1017.688
$raiz.error.cuadratico
[1] 35.66666
$error.relativo
[1] 0.04394823
$correlacion
[1] 0.9977232
Ambas son buenas predicciones aunque disminuye su correlación en comparación a la configuración de solo 2 capas.
library(dplyr)
errores <- rbind(as.data.frame(linear),as.data.frame(polynomial),as.data.frame(radial),as.data.frame(sigmoid),as.data.frame(indices4))
rownames(errores) <- c("SVM.linear"," SVM.polynomial","SVM.radial","SVM.sigmoid", "NeuralNet 2 capas")
erroreserrores %>%
filter(raiz.error.cuadratico == min(errores$raiz.error.cuadratico))Tomando como referencia el error cuadrático medio, el mejor modelo fue el de NeuralNet con dos capas de 6 y 3 neuronas.
El promedio de los errores fue 582.98.
La correlación fue de 97.83% la cual es bastante alta, incluso más alta que con el modelo de Regresión Múltiple de la tarea antes que fue de 99.89%.
En promedio el modelo se equivocó en un 2,96%.
AsientosNinno.csv que contiene detalles de ventas de asientos de niños para auto en una serie de tiendas similares a las del cliente, y además los datos incluyen variables que definen caracter´ısticas de la tienda y su localidad. La tabla de datos está formada por 400 filas y 13 columnas. Seguidamente se explican las variables que conforman la tabla.Cargue la tabla de datos en R y no elimine los NA. En caso de ser necesario, recodificar las variables de forma adecuada. Para medir el error tome un 20 % de la tabla de datos. Realice lo siguiente:
datos <- read.table("../datos/AsientosNinno.csv", dec = ".", sep = ";",header = T, stringsAsFactors = T)[,-1]
datos$CalidadEstant <- factor(datos$CalidadEstant,levels = c("Malo","Medio","Bueno"), ordered=TRUE)
str(datos)'data.frame': 400 obs. of 13 variables:
$ Ventas : num 9.5 11.22 10.06 7.4 4.15 ...
$ PrecioCompt : int 138 111 113 117 141 124 115 136 132 132 ...
$ Ingreso : int 73 48 35 100 64 113 105 81 110 113 ...
$ CercaniaEsc : num 0.635 0.7 0.518 1.032 0.623 ...
$ Publicidad : int 11 16 10 4 3 13 0 15 0 0 ...
$ Poblacion : int 276 260 269 466 340 501 45 425 108 131 ...
$ Precio : int 120 83 80 97 128 72 108 120 124 124 ...
$ CalidadEstant: Ord.factor w/ 3 levels "Malo"<"Medio"<..: 1 3 2 2 1 1 2 3 2 2 ...
$ Edad : int 42 65 59 55 38 78 71 67 76 76 ...
$ Educacion : int 17 10 12 14 13 16 15 10 10 17 ...
$ Urbano : int 1 1 1 1 1 0 1 1 0 0 ...
$ USA : int 1 1 1 1 0 1 0 1 0 1 ...
$ Desarrollo : num 1.074 0.101 0.335 0.491 0.319 ...
datos <- dummy_cols(datos, select_columns = c("CalidadEstant"),remove_selected_columns = T)
numero.predictoras <- dim(datos)[2] - 1
filas <- dim(datos)[1]
muestra <- sample(1:filas, floor(filas*0.20))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]
#elimino las variables
taprendizaje <- taprendizaje[,-c(4,13)]
ttesting <- ttesting[,-c(4,13)]library(traineR)
modelo.linear <- train.svm(Ventas~., data = taprendizaje, kernel = "linear")
prediccion.linear <- predict(modelo.linear, ttesting)
linear <- indices.precision(ttesting$Ventas ,prediccion.linear$prediction,numero.predictoras)
linear$error.cuadratico
[1] 0.9657302
$raiz.error.cuadratico
[1] 1.090225
$error.relativo
[1] 0.1128421
$correlacion
[1] 0.9393117
modelo.polynomial <- train.svm(Ventas~., data = taprendizaje, kernel = "polynomial")
prediccion.polynomial <- predict(modelo.polynomial, ttesting)
polynomial <- indices.precision(ttesting$Ventas ,prediccion.polynomial$prediction,numero.predictoras)
polynomial$error.cuadratico
[1] 2.582904
$raiz.error.cuadratico
[1] 1.782963
$error.relativo
[1] 0.1821303
$correlacion
[1] 0.8312323
modelo.radial <- train.svm(Ventas~., data = taprendizaje, kernel = "radial")
prediccion.radial <- predict(modelo.radial, ttesting)
radial <- indices.precision(ttesting$Ventas ,prediccion.radial$prediction,numero.predictoras)
radial$error.cuadratico
[1] 1.897467
$raiz.error.cuadratico
[1] 1.528183
$error.relativo
[1] 0.1542402
$correlacion
[1] 0.8800029
modelo.sigmoid <- train.svm(Ventas~., data = taprendizaje, kernel = "sigmoid")
prediccion.sigmoid <- predict(modelo.sigmoid, ttesting)
sigmoid <- indices.precision(ttesting$Ventas ,prediccion.sigmoid$prediction,numero.predictoras)
sigmoid$error.cuadratico
[1] 6.222045
$raiz.error.cuadratico
[1] 2.767291
$error.relativo
[1] 0.2741508
$correlacion
[1] 0.7030724
library(neuralnet)
library(traineR)
numero.predictoras <- dim(datos)[2] - 1
# Calcula el modelo usando solo los datos de training
# Se deben guardar las medias y las desviaciones
medias <- sapply(taprendizaje, mean)
desviaciones <- sapply(taprendizaje, sd)
# Se estandarizan los datos, esto se debe hacer de training y testing
taprendizaje.e <- as.data.frame(scale(taprendizaje, center = medias, scale = desviaciones))
ttesting.e <- as.data.frame(scale(ttesting, center = medias, scale = desviaciones))
# Generamos la fórmula
nombres <- colnames(taprendizaje.e)
formula <- as.formula(paste("Ventas ~", paste(nombres[!nombres %in% c("Ventas")], collapse = " + ")))
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(4,2), linear.output = TRUE, threshold = 0.05, stepmax = 50000)
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)# Predicción
# Primero se obtiene la predicción estandarizada
prediccion.nnet <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Ventas")])$net.result
# Luego se calcula la predicción final "des-estandarizando" los resultados
prediccion.nnet <- prediccion.nnet * desviaciones["Ventas"] + medias["Ventas"]
# Medición de precisión
NNET <- indices.precision(ttesting$Ventas, prediccion.nnet,numero.predictoras)
NNET$error.cuadratico
[1] 1.550542
$raiz.error.cuadratico
[1] 1.381434
$error.relativo
[1] 0.1443091
$correlacion
[1] 0.9034559
errores <- rbind(as.data.frame(linear),as.data.frame(polynomial),as.data.frame(radial),as.data.frame(sigmoid),as.data.frame(NNET))
rownames(errores) <- c("SVM.linear"," SVM.polynomial","SVM.radial","SVM.sigmoid", "NeuralNet")
erroreserrores %>%
filter(raiz.error.cuadratico == min(errores$raiz.error.cuadratico))Tomando como referencia el error cuadrático medio, el mejor modelo fue SVM con núcleo linear.
El promedio de los errores fue 0.87.
La correlación fue de 97.83% la cual es bastante alta, incluso más alta que con el modelo de Regresión Múltiple de la tarea antes que fue de 97.12%.
En promedio el modelo se equivocó en un 10%
Puede observar los puntos con el siguiente código: library ( p l o t l y ) datos <− data.frame ( x = c ( 1 , 1 , 1 , 3 , 1 , 3 , 1 , 3 , 1 ) , y = c ( 0 , 0 , 1 , 1 , 1 , 2 , 2 , 2 , 1 ) , z = c ( 1 , 2 , 2 , 4 , 3 , 3 , 1 , 1 , 0 ) , c l a s e = c ( ”Rojo” , ”Rojo” , ”Rojo” , ”Rojo” , ”Rojo” , ”Azul” , ”Azul” , ”Azul” , ”Azul” ) )
plot_ly (data = datos ) %> % add trace ( x = ˜x , y = ˜y , z = ˜z , c o l o r = ˜ cl a s e , colors = c ( ”#0C4B8E” , ”#BF382A” ) , mode = ” markers ” , type = ” s c a t t e r 3 d ” )
Realice lo siguiente:
library(plotly)
Datos <- data.frame ( x = c(1 , 1 , 1 , 3 , 1 , 3 , 1 , 3 , 1) ,y = c(0 , 0 , 1 , 1 , 1 , 2 , 2 , 2 , 1) , z = c(1 , 2 , 2 , 4 , 3 , 3 , 1 , 1 , 0) ,clase = c(" Rojo ", " Rojo ", " Rojo "," Rojo ", " Rojo ", " Azul "," Azul ", " Azul ", " Azul "))
plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d")hiperplanos de los márgenes luego trazar el hiperplano de soporte justo en el centro.
Datos2 <- data.frame ( x = c(1 , 1 , 3 ) ,y = c(0 , 1 , 1 ) , z = c(1 , 2 , 4 ))
Datos3 <- data.frame ( x = c(1 , 1 , 3 ) ,y = c(1 , 2 , 2 ) , z = c(0 , 1 , 3 ))
Datos4<-data.frame ( x = c(1 , 1 , 3 ) ,y = c(0.5 , 1.5 , 1.5 ) , z = c(0.5 , 1.5 , 3.5 ))
plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d") %>% add_trace(data = Datos2, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d",showlegend=FALSE) %>% add_trace(data = Datos3, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d" , showlegend=FALSE) %>% add_trace(data = Datos4, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d" , showlegend=FALSE)library(pracma)
vector.cross <- function(a, b) {
return (cross(a,b))
}
p<-c(1 , 0.5 , 0.5)
q<- c(1 , 1.5 , 1.5 )
r<-c(3 , 1.5 , 3.5 )
pq<-q-p
pr<-r-p
vector.cross(pq, pr) [1] 2 2 -2
#El margen para el hiperplano optimo es de 1.
#Los vectores de soporte serian:
vector1 <- cross(c(1 , 1 , 3 ) , c(0 , 1 , 1 ))
vector1[1] -2 -1 1
vector2 <- cross(c(1 , 2 , 2 ) , c(0 , 1 , 3 ))
vector2[1] 4 -3 1
Por que ese punto no fue utilizado para sacar el hiperplano óptimo por lo cual no afectaría.
Datos4<-data.frame ( x = c(1 , 1 , 3 ) ,y = c(0 , 1 , 1 ) , z = c(0.5 , 1.5 , 3.5 ))
plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d") %>% add_trace(data = Datos2, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d",showlegend=FALSE) %>% add_trace(data = Datos3, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d" , showlegend=FALSE) %>% add_trace(data = Datos4, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d" , showlegend=FALSE) p<-c(1 , 0 , 0.5 )
q<- c(1, 1 , 1.5 )
r<-c(3 , 1 , 3.5 )
pq<-q-p
pr<-r-q
vector.cross(pq, pr) [1] 2 2 -2
Datos4<-data.frame ( x = c(0 , 0 , 2 ) ,y = c( 0.1, 1.1 , 1.1 ) , z = c(0.5 , 1.5 , 3.5 ))
plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d") %>% add_trace(data = Datos2, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d",showlegend=FALSE) %>% add_trace(data = Datos3, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d" , showlegend=FALSE) %>% add_trace(data = Datos4, x = ~x , y = ~y , z = ~z , mode = 'lines', type = "scatter3d" , showlegend=FALSE) p<-c(0 , 0.1 , 0.5 )
q<- c( 0, 1.1 , 1.5 )
r<-c(2 , 1.1 , 3.5 )
pq<-q-p
pr<-r-p
vector.cross(pq, pr)[1] 2 2 -2
Datos <- data.frame ( x = c(1 , 1 , 1 , 3 , 1 , 3 , 1 , 3 , 1, 2) ,y = c(0 , 0 , 1 , 1 , 1 , 2 , 2 , 2 , 1, 4) , z = c(1 , 2 , 2 , 4 , 3 , 3 , 1 , 1 , 0, 2) ,clase = c(" Rojo ", " Rojo ", " Rojo "," Rojo ", " Rojo ", " Azul "," Azul ", " Azul ", " Azul "," Rojo "))
plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d")\[ f(w) = \dfrac{||w||^2}{2} + C\Big(\sum _{i=1}^{n}\xi_i \Big)^2, \] donde \(C\) es un parámetro del modelo, entonces Lagrangiano Dual para la Máquina Vectorial de Soporte lineal con datos no separables es:
\[ L_D = \sum _{i=1}^{n} \lambda_i - \dfrac{1}{2}\sum_{i,j} \lambda_i \lambda_jy_iy_jx_i\cdot x_j - C\Big(\sum _{i=1}^{n}\xi_i \Big)^2. \]
Construyendo el Lagrangiano y basandonos en la diapositiva 42 tenemos:
\[ L_p = \dfrac{||w||^2}{2} + C\Big(\sum _{i=1}^{n}\xi_i \Big)^2 - \sum_{i=1}^{n} \lambda_i(y_i(w_ix_i+b)-1+\epsilon_i) - \sum_{i=1}^{n} \mu_i\epsilon_i \] Derivando:
\(\dfrac{\partial L_p}{\partial w_i} = w_j - \sum_{i=1}^{N} \lambda_i y_ix_{ij} = 0 \Rightarrow w_j = \sum_{i=1}^{N} \lambda_i y_ix_{ij}\)
\(\dfrac{\partial L_p}{\partial b} = - \sum_{i=1}^{N} \lambda_iy_i = 0 \Rightarrow \sum_{i=1}^{N} \lambda_iy_i = 0\)
\(\dfrac{\partial L_p}{\partial \epsilon_i} = C - \lambda_i \mu_i =0 \Rightarrow \lambda_i + \mu_i = C\)
De esta forma en \(L_p\):
\[\begin{align*} L_p &= \dfrac{1}{2} \sum_{i,j=1}^{n} \lambda_i\lambda_jy_iy_jx_ix_j + C(\sum_{i=1}^{n}\xi_i)^2 \\ & -\sum_{i=1}^{n}\lambda_i (y_i(\sum_{j=1}^{n} \lambda_j\lambda_j y_j x_i x_j + b) - 1 + \epsilon_i) \\ & - \sum_{i=1}^{n}(2C\sum_{i=1}^{n}\epsilon_i - \lambda_i) \\ \epsilon_j \\ &= \dfrac{1}{2} \sum_{i=1}^{n} \lambda_i \lambda_j y_i y_j x_i x_j + C (\sum_{i=1}^{n}\epsilon_i)^2-\sum_{i,j = 1}^{n} \lambda_i \lambda_j y_i y_j x_i x_j \\ & - \sum_{i=1}^{n} \lambda_i y_i \sum_{j=1}^{n} b_j + \sum_{i=1}^{n} \lambda_i - \sum_{i=1}^{n} \lambda_i y_i \epsilon_i - 2C(\sum_{i=1}^{n}\epsilon_i)^2 + \sum_{i=1}^{n} \lambda_i y_i \epsilon_i \\ & = \sum_{i=1}^{n} \lambda_i - \dfrac{1}{2} \sum_{i=1}^{n} \lambda_i \lambda_j y_i y_j x_i x_j - C(\sum_{i=1}^{n}\xi_i)^2 - nb \sum_{i=1}^{n} \lambda_i y_i \end{align*}\]
Y como \(\sum_{i=1}^{n} \lambda_i y_i = 0\), tenemos:
\[ L_D = \sum_{i=1}^{n} \lambda_i - \dfrac{1}{2} \sum_{i,j =1}^{n} \lambda_i \lambda_j y_i y_j x_i x_j - C(\sum_{i=1}^{n} \xi_i)^2 \]
\[ \vec{x} = \begin{pmatrix} 2 \\ 3 \\ -1 \\ 2 \end{pmatrix} \] Tiene la siguientes matrices de pesos
\[ W_{1} = \begin{pmatrix} 2 & 3 & 0 & 1 \\ 4 & 3 & 2 & 0 \\ 1 & 1 & 1 & 2 \\ \end{pmatrix}, \quad W_{2} = \begin{pmatrix} 1 & 7 & 1 \\ 7 & 1 & 4 \\ \end{pmatrix} \]
Tiene el siguiente bías \[ \vec{b} = \begin{pmatrix} -6 \\ -2 \end{pmatrix} \]
Además, use la siguiente función de activación en todas las neuronas:
\[ g(x) = \dfrac{1}{1+e^{-x}} \]
\[\begin{align*} y &= g(W_1 \cdot\vec{x}) = g \Bigg(\begin{pmatrix} 2 & 3 & 0 & 1 \\ 4 & 3 & 2 & 0 \\ 1 & 1 & 1 & 2 \\ \end{pmatrix} \begin{pmatrix} 2 \\ 3 \\ -1 \\ 2 \end{pmatrix} \Bigg) = g \begin{pmatrix} 15 \\ 15 \\ 8 \end{pmatrix} = \begin{pmatrix} 0.9999 \\ 0.9999 \\ 0.9996 \end{pmatrix} \\ z &= g(W_2 \cdot\vec{y} + \vec{b}) = g \Bigg( \begin{pmatrix} 1 & 7 & 1 \\ 7 & 1 & 4 \\ \end{pmatrix} \begin{pmatrix} 0.9999 \\ 0.9999 \\ 0.9996 \end{pmatrix} + \begin{pmatrix} -6 \\ -2 \end{pmatrix} \Bigg) = g \Bigg( \begin{pmatrix} \dfrac{22497}{2500} \\ \dfrac{14997}{1250} \end{pmatrix} + \begin{pmatrix} -6 \\ -2 \end{pmatrix} \Bigg) \\ z &= \begin{pmatrix} 2.9987 \\ 9.9976 \end{pmatrix} \end{align*}\]
predecir es \(z\) diseñe una Red Neuronal de una capa (Perceptron):
Es decir, encuentre todos los posibles pesos \(x_1,w_2,w_3\) y umbrales \(\theta\) para la Red Neuronal que se muestra en el siguiente gráfico:
Use una función de activación tipo \(tanh(x)\), es decir:
\[f(x) = \tanh(x) = \dfrac{e^{x} - e^{-x}}{e^{x} + e^{-x}}\] Para esto escriba una Clase en Python que incluya los métodos necesarios pra implementar esta Red Neuronal. Se deben hacer variar los pesos \(w_j\) con \(j = 1,2,3\) en los siguientes valores v=(-1,-0.9,-0.8,...,0,...,0.8,0.9,1) y haga variar θ en u=(0,0.1,...,0.8,0.9,1). Escoja los pesos \(w_j\) con \(j = 1, 2, 3\) y el umbral θ de manera que se minimiza el error cuadrático medio:
\[E(w_1,w_2,w_3) = \dfrac{1}{4} \sum_{i=1}^{4}\Big[ I\Big[ f\Big(\sum_{j=1}^{3}w_j \cdot x_{i}^{j} - θ \Big)\Big] - z_i\Big]^2 \]
donde \(x_i^j\) es la entrada en la fila \(i\) de la variable \(x^j\) e \(I(z)\) se define como sigue:
\[ I(t) = \begin{cases} 1 & \text{si $t \geq 0$} \\ 0 & \text{si $t < 0$} \end{cases} \]
x1 <- c(1,1,1,1)
x2 <- c(0,0,1,1)
x3 <- c(0,1,0,1)
z <- c(1,1,1,0)
tabla <- data.frame(x1,x2,x3,z)
#función de activación
tangenteHiperb <- function(x){
y <- 2/(1+exp(-2*x)) - 1
return(y)
}
I <- function(t){
if(t >= 0){
return(1)
}else {
return(0)
}
}
#Pesos
v <- seq(-1,1,0.1)
u <- seq(0,1,0.1)
error <- data.frame()
for (omega in u) {
for (w1 in v) {
for (w2 in v) {
for (w3 in v) {
s <- 0
for (i in 1:4) {
s <- s + (I(tangenteHiperb(w1*tabla[i,1] - omega + w2*tabla[i,2] - omega + w3*tabla[i,3] - omega)) - tabla[i,4])^2
}
error <- rbind(error,data.frame(w1,w2,w3,omega,s/4))
}
}
}
}Pesos y umbral que minimizan el error
names(error)[5] <- c("Error")
error%>%filter(Error == 0)R.\[ f(x) = 3x^4 - 16x^3 + 18x^2 \]
Paso 1
\(f(x_0) = 3(2)^4 - 16(2)^3 +18(2)^2 = -8\)
Paso 2
$f’(x_0) = f’(2) = -24 $
Paso 3
Tomanto \(\eta = 0.05\)
\(x_1 = x_0 - \eta \cdot f'(x_0) = 2 - 0.05 \cdot -24 = 3.2\)
\(\Rightarrow f(x_1) = f(3.2)= -25.3952\)
Tenemos el par \((3.2,-25.3952)\)
Rlibrary(ggplot2)
funcion <- function(x){
3 * x^4 -16 * x^3 + 18 * x^2
}
t1 <- c(-5.0,5.0,0.1)
x = 2.0
y = funcion(x)
ggplot()+
xlim(-5.0,5.0)+
ylim(-45,45)+
geom_function(fun = funcion)+
geom_point(aes(x=x,y=y), colour = "red")+
theme_minimal()derivada <- function(x){
12*x^3 - 48*x^2 + 36*x
}
pendiente <- derivada(x)
pendiente[1] -24
eta = 0.05
x[2]<- x - eta*pendiente
x[1] 2.0 3.2
y[2] <- funcion(x[2])
y[1] -8.0000 -25.3952
ggplot()+
xlim(-1.0,5.0)+
ylim(-45,45)+
geom_function(fun = funcion)+
geom_point(aes(x=x,y=y), colour = "red")+
theme_minimal()R.\[ f(x,y) = x^2 + y^2 -2x-6y+14 \]
Note que \(f_x(x,y) = 2x -2\) y \(f_y(x,y)= 2y -6\)
\(\nabla f = \begin{bmatrix} 2x - 2 \\ 2y -6 \end{bmatrix}\)
Sea $x_0 = \[\begin{bmatrix} -5 \\ 5 \end{bmatrix}\]. $ Entonces $f(x_0) = 44 $
Tomando \(\eta = 0.1\)
\(x_1 = x_0 - \eta \cdot f'(x_0) = \begin{bmatrix} -5 \\ 5 \end{bmatrix} - 0.1 \cdot \begin{bmatrix} -12 \\ 4 \end{bmatrix} = \begin{bmatrix} -3.8 \\ 4.6 \end{bmatrix}\)
\(\Rightarrow f(x_1) = f\Big(\begin{bmatrix} -3.8 \\ 4.6 \end{bmatrix}\Big)= -29.5999\)
library(dplyr)
library(plotly)
library(pracma)
funcion <- function(x,y){
x^2 + y^2 - 2*x - 6*y + 14
}
x = -5
y = 5
x0 = c(x,y)
x0[1] -5 5
fx0 <- funcion(x,y)
fx0[1] 44
gradiente <- function(x,y){
c(2*x -2 , 2*y -6)
}
gradiente_f <- gradiente(-5,5)
gradiente_f[1] -12 4
eta = 0.1
x1 = x0 - eta * gradiente(-5,5)
x1[1] -3.8 4.6
z = funcion(x1[1],x1[2])
z[1] 29.6
xi = c(x,y)
for(i in c(1,2)){
xi = xi -eta * gradiente(xi[1],xi[2])
x = append(x,xi[1])
y= append(y,xi[2])
z = append(z, funcion(xi[1],xi[2]))
}
datos = data.frame(X=x,Y=y,Z=z)
datosxdata = seq(-10,10,by=0.1)
ydata = seq(-10,10,by= 0.1)
data = meshgrid(xdata,ydata)
X = data$X
Y = data$Y
Z = X^2 + Y^2 - 2*X - 6*Y + 14
plot_ly(x = X, y = Y, z = Z)%>%
add_surface()%>%
add_trace(datos,type = "scatter3d", mode="markers", x =
~x, y = ~y, z = ~z)datosPython.\[ f(x,y) = x^4 + y^4 -4xy+1 \]
Note que \(f_x(x,y) = 4x^3 -4y\) y \(f_y(x,y)= 4y^3 -4x\)
\(\nabla f = \begin{bmatrix} 4x^3 - 4y \\ 4y^3 - 4x \end{bmatrix}\)
Sea $x_0 = \[\begin{bmatrix} -0.5 \\ 0.5 \end{bmatrix}\]. $ Entonces $f(x_0) = 2.125 $
Tomando \(\eta = 0.1\)
\(x_1 = x_0 - \eta \cdot f'(x_0) = \begin{bmatrix} -0.5 \\ 0.5 \end{bmatrix} - 0.1 \cdot \begin{bmatrix} -2.5 \\ 2.5 \end{bmatrix} = \begin{bmatrix} -0.25 \\ 0.25 \end{bmatrix}\)
\(\Rightarrow f(x_1) = f\Big(\begin{bmatrix} -0.25 \\ 0.25 \end{bmatrix}\Big)= 1.2578\)
funcion <- function(x,y){
x^4 + y^4 - 4*x*y + 1
}
x = -0.5
y = 0.5
x0 = c(x,y)
x0[1] -0.5 0.5
fx0 <- funcion(x,y)
fx0[1] 2.125
gradiente <- function(x,y){
c(4*x^3 - 4*y , 4*y^3 - 4*x)
}
gradiente_f <- gradiente(x,y)
gradiente_f[1] -2.5 2.5
eta = 0.1
x1 = x0 - eta * gradiente(x,y)
x1[1] -0.25 0.25
z = funcion(x1[1],x1[2])
z[1] 1.257812
xi = c(x,y)
for(i in c(1,2)){
xi = xi -eta * gradiente(xi[1],xi[2])
x = append(x,xi[1])
y= append(y,xi[2])
z = append(z, funcion(xi[1],xi[2]))
}
datos = data.frame(X=x,Y=y,Z=z)
datosxdata = seq(-10,10,by=0.1)
ydata = seq(-10,10,by= 0.1)
data = meshgrid(xdata,ydata)
X = data$X
Y = data$Y
Z = X^4 + Y^4 - 4*X*Y + 1
plot_ly(x = X, y = Y, z = Z)%>%
add_surface()%>%
add_trace(datos,type = "scatter3d", mode="markers", x =
~x, y = ~y, z = ~z)